1. Podstawowe informacje na temat rasowo-etnicznej struktury ludności

1.1 Hrabstwo Wayne - informacje

Najbardziej zaludnione hrabstwo znajdujące się w stanie Michigan w Stanach Zjednoczonych. Według danych z 2020r. znalazło się ono na 19. miejscu wśród najbardziej zaludnionych hrabstw w Stanach zjednoczonych. Jego obszar całkowity obejmuje powierzchnię 1 741 km². Siedziba hrabstwa znajduje się w Detroit. Detroit graniczy z kanadyjskim miastem Windsor.

1.2 Hrabstwo Wayne w liczbach

Liczba ludności w hrabstwie Wayne:

1990: 2 111 687
2000: 2 061 162
2010: 1 820 574
2020: 1 793 561

Procentowy udział głównych grup rasowo-etnicznych 1990/2020:

Biała: 56.14/47.79
Afroamerykanie: 40.03/37.32
Latynosi: 2.39/6.56
Azjaci: 1.00/3.61
Rdzenni Amerykanie: 0.35/0.24
Inni : 0.08/4.48

W badanym okresie liczba ludności hrabstwa Wayne zmniejszyła się o ~15%. Zaobserwowano również zmiany w strukturze rasowo-etnicznej.

2. Przestrzenny rozkład segregacji oraz zróżnicowania rasowego w hrabstwie w latach 1990-2020

2.1. Rozkład wartości wskaźnika H na poziomie obszarów spisowych dla poszczególnych lat

p1 <- ggplot(data = wayne_idx_1990) +
  geom_sf(aes(fill = H)) +
  scale_fill_gradient2(name = "Wskaźnik H", low = "darkgreen",mid = "yellow", high = "red",midpoint = 0.5 ,limits = c(0, 1)) +
  labs(title = "1990") + 
  theme_bw() + theme(
    axis.text = element_blank(),
    axis.ticks = element_blank(),
    panel.grid = element_blank()
  )

p2 <- ggplot(data = wayne_idx_2000) +
  geom_sf(aes(fill = H)) +
  scale_fill_gradient2(name = "Wskaźnik H", low = "darkgreen",mid = "yellow", high = "red",midpoint = 0.5 ,limits = c(0, 1)) +
  labs(title = "2000") + 
  theme_bw() + theme(
    axis.text = element_blank(),
    axis.ticks = element_blank(),
    panel.grid = element_blank()
  )

p3 <- ggplot(data = wayne_idx_2010) +
  geom_sf(aes(fill = H)) +
  scale_fill_gradient2(name = "Wskaźnik H", low = "darkgreen",mid = "yellow", high = "red",midpoint = 0.5 ,limits = c(0, 1)) +
  labs(title = "2010") + 
  theme_bw() + theme(
    axis.text = element_blank(),
    axis.ticks = element_blank(),
    panel.grid = element_blank()
  )

p4 <- ggplot(data = wayne_idx_2020) +
  geom_sf(aes(fill = H)) +
  scale_fill_gradient2(name = "Wskaźnik H", low = "darkgreen",mid = "yellow", high = "red",midpoint = 0.5 ,limits = c(0, 1)) +  # Consistent legend title
  labs(title = "2020") + 
  theme_bw() + theme(
    axis.text = element_blank(),
    axis.ticks = element_blank(),
    panel.grid = element_blank()
  )

print(p1)

print(p2)

print(p3)

print(p4)

cls_color <- c("L"= "#008000", "M"= "#FFFF00", "H"= "#FF0000")

colpal <- cls_color[names(cls_color)%in%unique(wayne_idx_1990$H_cls)]

wayne_idx_1990$H_cls <- factor(wayne_idx_1990$H_cls, levels = c("H", "M", "L"))
wayne_idx_2000$H_cls <- factor(wayne_idx_2000$H_cls, levels = c("H", "M", "L"))
wayne_idx_2010$H_cls <- factor(wayne_idx_2010$H_cls, levels = c("H", "M", "L"))
wayne_idx_2020$H_cls <- factor(wayne_idx_2020$H_cls, levels = c("H", "M", "L"))

p1 <- ggplot(data = wayne_idx_1990) +
  geom_sf(aes(fill = H_cls)) +
  scale_fill_manual(values = colpal) + 
  labs(title = "1990", fill = "Wskaźnik H") + 
  theme_bw() + theme(
  axis.text = element_blank(),
  axis.ticks = element_blank(),
  panel.grid = element_blank())

p2 <- ggplot(data = wayne_idx_2000) +
  geom_sf(aes(fill = H_cls)) +
  scale_fill_manual(values = colpal) + 
  labs(title = "2000", fill = "Wskaźnik H") + 
  theme_bw() + theme(
    axis.text = element_blank(),
    axis.ticks = element_blank(),
    panel.grid = element_blank()
  ) +
  guides(fill = 'none')

p3 <- ggplot(data = wayne_idx_2010) +
  geom_sf(aes(fill = H_cls)) +
  scale_fill_manual(values = colpal) + 
  labs(title = "2010", fill = "Wskaźnik H") + 
  theme_bw() + theme(
    axis.text = element_blank(),
    axis.ticks = element_blank(),
    panel.grid = element_blank()
  )

p4 <- ggplot(data = wayne_idx_2020) +
  geom_sf(aes(fill = H_cls)) +
  scale_fill_manual(values = colpal) + 
  labs(title = "2020", fill = "Wskaźnik H") + 
  theme_bw() + theme(
    axis.text = element_blank(),
    axis.ticks = element_blank(),
    panel.grid = element_blank()
  ) + 
  guides(fill = 'none')

combined2 <- p1 + p2 + p3 + p4 + plot_layout(guides = "collect") & theme(legend.position = "right")

combined2 = combined2 + plot_annotation("Klasyfikacja wkaźnika H na poziomie obszarow spisowych")

print(combined2)

Badając przestrzenny rozkład wartości wskaźnika H można zaobserwować różnice pomiędzy częściami Hrabstwa Wayne. W 2020 roku obszarem o największym poziomie segregacji rasowej były głównie obszary spisowe znajdujące się w centrum miasta, w szczególności te w północnej części. Porównując wizualizacje dla poszczególnych lat można również zaobserwować stopniowe zmiany na obszarze w skali czasowej gdzie wyróżnia się rzadziej zaludniona południowa część badanego obszaru. Widać tam spadek poziomu segregacji rasowej na przestrzeni okresu od 1990 do 2020. Pewną tendencją spadkową wykazało się również same centrum miasta gdzie w latach 1990 i 2010 występowały obszary o maksymalnej wartości wskaźnika teorii informacji H. Najmniejszą zmiennością wykazały się obszary położone na północ od centrum miasta gdzie poziom segregacji rasowej utrzymywał się na podobnym poziomie na przestrzeni badanego okresu. Ogólnie na podstawie map rozkładu wartości wskaźnika H można stwierdzieć, że poziom segregacji rasowej na terenie Hrabstwa Wayne w latach 1990-2020 stopniowo spadał.

2.2. Rozkład wartości entropii standaryzowanej na poziomie obszarów spisowych dla poszczególnych lat

p1 <- ggplot(data = wayne_idx_1990) +
  geom_sf(aes(fill = Estd)) +
  scale_fill_gradient2(name = "Entropia Zestandaryzowana", low = "darkgreen",mid = "yellow", high = "red",midpoint = 0.5 ,limits = c(0, 1)) + 
  labs(title = "1990") + 
  theme_bw() + theme(
    axis.text = element_blank(),
    axis.ticks = element_blank(),
    panel.grid = element_blank()
  )

p2 <- ggplot(data = wayne_idx_2000) +
  geom_sf(aes(fill = Estd)) +
  scale_fill_gradient2(name = "Entropia Zestandaryzowana", low = "darkgreen",mid = "yellow", high = "red",midpoint = 0.5 ,limits = c(0, 1)) + 
  labs(title = "2000") + 
  theme_bw() + theme(
    axis.text = element_blank(),
    axis.ticks = element_blank(),
    panel.grid = element_blank()
  )

p3 <- ggplot(data = wayne_idx_2010) +
  geom_sf(aes(fill = Estd)) +
  scale_fill_gradient2(name = "Entropia Zestandaryzowana", low = "darkgreen",mid = "yellow", high = "red",midpoint = 0.5 ,limits = c(0, 1)) + 
  labs(title = "2010") + 
  theme_bw() + theme(
    axis.text = element_blank(),
    axis.ticks = element_blank(),
    panel.grid = element_blank()
  )

p4 <- ggplot(data = wayne_idx_2020) +
  geom_sf(aes(fill = Estd)) +
  scale_fill_gradient2(name = "Entropia Zestandaryzowana", low = "darkgreen",mid = "yellow", high = "red",midpoint = 0.5 ,limits = c(0, 1)) +
  labs(title = "2020") + 
  theme_bw() + theme(
    axis.text = element_blank(),
    axis.ticks = element_blank(),
    panel.grid = element_blank()
  )

print(p1)

print(p2)

print(p3)

print(p4)

cls_color <- c("L"= "#008000", "M"= "#FFFF00", "H"= "#FF0000")

colpal <- cls_color[names(cls_color)%in%unique(wayne_idx_1990$Estd_cls)]

wayne_idx_1990$Estd_cls <- factor(wayne_idx_1990$Estd_cls, levels = c("H", "M", "L"))
wayne_idx_2000$Estd_cls <- factor(wayne_idx_2000$Estd_cls, levels = c("H", "M", "L"))
wayne_idx_2010$Estd_cls <- factor(wayne_idx_2010$Estd_cls, levels = c("H", "M", "L"))
wayne_idx_2020$Estd_cls <- factor(wayne_idx_2020$Estd_cls, levels = c("H", "M", "L"))

p1 <- ggplot(data = wayne_idx_1990) +
  geom_sf(aes(fill = Estd_cls)) +
  scale_fill_manual(values = colpal) + 
  labs(title = "1990", fill = "Entropia Zestandaryzowana") + 
  theme_bw() + theme(
  axis.text = element_blank(),
  axis.ticks = element_blank(),
  panel.grid = element_blank())

p2 <- ggplot(data = wayne_idx_2000) +
  geom_sf(aes(fill = Estd_cls)) +
  scale_fill_manual(values = colpal) + 
  labs(title = "2000", fill = "Entropia Zestandaryzowana") + 
  theme_bw() + theme(
    axis.text = element_blank(),
    axis.ticks = element_blank(),
    panel.grid = element_blank()
  ) +
  guides(fill = 'none')

p3 <- ggplot(data = wayne_idx_2010) +
  geom_sf(aes(fill = Estd_cls)) +
  scale_fill_manual(values = colpal) + 
  labs(title = "2010", fill = "Entropia Zestandaryzowana") + 
  theme_bw() + theme(
    axis.text = element_blank(),
    axis.ticks = element_blank(),
    panel.grid = element_blank()
  )

p4 <- ggplot(data = wayne_idx_2020) +
  geom_sf(aes(fill = Estd_cls)) +
  scale_fill_manual(values = colpal) + 
  labs(title = "2020", fill = "Entropia Zestandaryzowana") + 
  theme_bw() + theme(
    axis.text = element_blank(),
    axis.ticks = element_blank(),
    panel.grid = element_blank()
  ) + 
  guides(fill = 'none')

combined2 <- p1 + p2 + p3 + p4 + plot_layout(guides = "collect") & theme(legend.position = "right")

combined2 = combined2 + plot_annotation("Klasyfikacja entropii zestandaryzowanej na poziomie obszarow spisowych")

print(combined2)

Na podstawie przestrzennej reprezentacji poziomu entropii zestandaryzowanej dla poszczególnych obszarów spisowych Hrabstwa Wayne można zauważyć drastyczne zmiany w poziomie zróżnicowania rasowego regionu. Podczas gdy w roku 1990 niemal jedynym obszarem o dużej różnorodności rasowej było centrum miasta, z każdą następną dekadą widać jak poziom zróżnicowania rasowego na obrzeżach miasta stopniowo rośnie. Podczas gdy w samym centrum różnorodniość etniczna również wzrosła, niezwykle gwałtowną tendencją wzrostową wykazały się rzadziej zaludnione południowe obszary spisowe Hrabstwa Wayne, gdzie w 1990 roku przeważały obszary o niskim poziomie zróżnicowania rasowego natomiast w roku 2020 dorównują one w swojej wieloetniczności poziomom obserwowanym w centrum. Najmniejszą zmiennością podobnie jak w przypadku wskaźnika H wykazały się tereny na północ od głównego skupiska miejskiego.

2.3. Typy struktur rasowo-etnicznych

biv_colors = stevens.bluered()
names(biv_colors) = c("LL", "ML", "HL", "LM", "MM", "HM", "LH", "MH", "HH")

p1 <- ggplot(data = wayne_idx_1990) +
  geom_sf(aes(fill = biv_cls)) +
  scale_fill_manual(values = biv_colors) +
  labs(title = "1990", fill = "Struktura rasowo-etniczna") +
  theme_bw() + theme(
    axis.text = element_blank(),
    axis.ticks = element_blank(),
    panel.grid = element_blank())

p2 <- ggplot(data = wayne_idx_2000) +
  geom_sf(aes(fill = biv_cls)) +
  scale_fill_manual(values = biv_colors) +
  labs(title = "2000", fill = "Struktura rasowo-etniczna") +
  theme_bw() + theme(
    axis.text = element_blank(),
    axis.ticks = element_blank(),
    panel.grid = element_blank()
  )

p3 <- ggplot(data = wayne_idx_2010) +
  geom_sf(aes(fill = biv_cls)) +
  scale_fill_manual(values = biv_colors) +
  labs(title = "2010", fill = "Struktura rasowo-etniczna") +
  theme_bw() + theme(
    axis.text = element_blank(),
    axis.ticks = element_blank(),
    panel.grid = element_blank()
  )

p4 <- ggplot(data = wayne_idx_2020) +
  geom_sf(aes(fill = biv_cls)) +
  scale_fill_manual(values = biv_colors) +
  labs(title = "2020", fill = "Struktura rasowo-etniczna") +
  theme_bw() + theme(
    axis.text = element_blank(),
    axis.ticks = element_blank(),
    panel.grid = element_blank()
  )


print(p1)

print(p2)

print(p3)

print(p4)

Powyższy wykres przedstawia typy struktur rasowo etnicznych dla obszarów spisowych w Hrabstwie Wayne dla poszczególnych lat. Kategorie zostały stworzone poprzez kombinację klasyfikacji entropii zestandaryzowanej (pierwsza litera) i wzkaźnika H (druga litera): L - niski poziom, M - średni poziom, H - wysoki poziom. Na podstawie wizualizacji można zaobserwować, że podczas gdy w roku 1990 poza centrum miasta dominowały obszary o niskim zróżnicowaniu rasowym i niskiej segregacj (LL), w kolejnych latah coraz bardziej dominujące stały się obszary o średnim zróżnicowaniu i niskiej segregacj (ML). Zarówno w centrum jak i na obrzeżach miasta pojawiło się również znacznie więcej obszarów o wysokim zróżnicowaniu etnicznym i niskiej segregacji (HL). W żadnym z badanych lat nie wystąpiły natomiast obszary o wysokim poziomie segregacji i zróżnicowania rasowego. Zwłasza w pobliżu centrum pojawiło się dużo obszarów o średniej wartości obydwu wskaźników. Niezaskakująco, miejscem które wykazało się najmniejszą zmiennością w czasie są obszary znajdujące się na północny-zachód od śródmieścia.

2.4. Ilość obszarów spisowych dla poszczególnych typów w 1990 roku

table(wayne_idx_1990$biv_cls)

## 
##  HL  LH  LL  LM  ML  MM 
##   1   1 449  38 112  23

2.5. Ilość obszarów spisowych dla poszczególnych typów w 2020 roku

table(wayne_idx_2020$biv_cls)

## 
##  HL  HM  LL  LM  ML  MM 
##  40   1 225  14 305  14

2.6. Mapa zmian między rokiem 1990-2020

Mapa ta uwidacznia zmiany typów struktury rasowo-etnicznej. Została przygotowana w oprogramowaniu QGIS.

Strukturę rasowo-etniczną ludności klasyfikujemy odpowiednio:
1. Typ mało zróżnicowany (grupa dominująca powyżej 80%):

• zdominowany przez białych (WL)

• zdominowany przez czarnych (BL)

• zdominowany przez Azjatów (AL)

• zdominowany przez Latynosów (HL)

2. Typ średnio zróżnicowany (grupa dominująca 50%-80%):

• zdominowany przez białych (WM)

• zdominowany przez czarnych (BM)

• zdominowany przez Azjatów (AM)

• zdominowany przez Latynosów (HM)

3. Typ o dużym zróżnicowaniu - HD (żadna grupa nie przekracza 50%)

knitr::include_graphics("result/raport/mapa_zmian.png")

Do zmian doszło praktycznie na większości obszarów spisowych (część ludności białej bez zmian w południowej i północnej części, podobnie wiele obszarów z ludnością czarną w mieście Detroit). Na pierwszy rzut oka zauważamy spadek udziału ludności białej (z dominacji >80% WL do dominacji 50%-80% WM). Za to ludność czarna na przestrzeni lat zwiększa swój udział na przedmieściach Detroit (głównie BM→BL). Również na przedmieściach pojawił się mniejszy i większy udział Latynosów tym samym zmniejszając udział ludności białej i o dużym zróżnicowaniu (HD→HM, WM→HM). Patrząc na zachód zauważamy zmniejszenie udziału ludności białej na rzecz ludności o dużym zróżnicowaniu (WL→HD).

2.7. Macierz przejść klasyfikacji obszarów spisowych między rokiem 1990 a 2020

wayne_1990 = st_drop_geometry(wayne_1990)
wayne_1990 = select(wayne_1990, 1,'race_cls')
wayne_1990 = rename(wayne_1990, race_cls_1990 = race_cls) 

wayne_2020 = st_drop_geometry(wayne_2020)
wayne_2020 = select(wayne_2020, 1,'race_cls')
wayne_2020 = rename(wayne_2020, race_cls_2020 = race_cls) 

wayne_1990_2020 = merge(wayne_1990, wayne_2020, by = "GISJOIN")

# table(wayne_1990_2020$race_cls_1990)

# table(wayne_1990_2020$race_cls_2020)

trans_matrix = table(wayne_1990_2020$race_cls_1990, wayne_1990_2020$race_cls_2020)

# write.csv(trans_matrix, "dane\\transition_matrix.csv")

trans_matrix

##     
##       AM  BL  BM  HD  HL  HM  WL  WM
##   BL   0 153  20   1   0   0   0   0
##   BM   1  28  15  10   0   0   0   4
##   HD   0   2   1   3   1   2   0   2
##   HM   0   0   0   0   1   0   0   0
##   WL   1   7  16  48   0   0 124 139
##   WM   0  11   9   8   3   8   1   6

Macierz ta przedstawia przejścia klas z 1990r. do 2020r. Wiersz zawiera dane z 1990, zaś kolumny dla roku 2020. Przykładowo: wartość 20 (pierwszy wiersz, trzecia kolumna) oznacza, że 20 obszarów spisowych sklasyfikowanych w roku 1990 jako BL już w roku 2020 zmieniło swój typ na BM. Do największego przejścia doszło z WL do WM - 139 obszarów spisowych.

Liczba obszarów spisowych według typów w 1990r.

rowSums(trans_matrix) # dla typów w 1990

##  BL  BM  HD  HM  WL  WM 
## 174  58  11   1 335  46

Liczba obszarów spisowych według typów w 2020r.

colSums(trans_matrix) # dla typów w 2020

##  AM  BL  BM  HD  HL  HM  WL  WM 
##   2 201  61  70   5  10 125 151

Po zsumowaniu wartości w wierszach i kolumnach widzimy, że największą dominację ma ludność biała oraz czarna. Sytuacja ta nie zmienia się w 2020, lecz udział WL spadł na rzecz WM, HD, BM.

3. Analiza zmian typów struktury rasowo-etnicznej ludności (klasyfikacja na 9 typów na podstawie procentowego udziału danej grupy rasowo-etnicznej)

3.1. Mapa typów zróżnicowania rasowego dla roku 1990, 2000, 2010, 2020

## Wczytanie danych
wayne_aggr1990 =  read.csv('dane\\wayne_aggr_1990.csv')
wayne_1990 = read.csv('dane\\wayne_1990.csv')
list_race <- c("whites", "blacks", "asians", "native_americans", "others", "latino")
bnd_1990 <- st_read("dane\\wayne.gpkg", layer = "wayne_1990")

wayne_1990$tot = wayne_1990$whites + wayne_1990$blacks + wayne_1990$asians + wayne_1990$native_americans + wayne_1990$others + wayne_1990$latino

## Wczytanie funkcji
entropy = function(pi){
  entropy = -sum(pi*log(pi), na.rm = TRUE)
  return(entropy)}

bivcol = function(pal){
  tit = substitute(pal)
  pal = pal()
  ncol = length(pal)
  image(matrix(seq_along(pal), nrow = sqrt(ncol)),
        axes = FALSE, 
        col = pal, 
        asp = 1)
  mtext(tit)
}


#utworzenie ramki danych zawierajacej identyfikator obszaru spisowego (GISJOINT) oraz ogólną liczbę ludności dla każdego obszaru spisowego. 
out_ct_1990 <- data.frame(GISJOIN_T = wayne_aggr1990$GISJOIN_T, pop = wayne_aggr1990$tot)

#obliczenie odsetka ras dla poszczegolnych obszarow spisowych (dane wejsciowe do obliczenia entropii)
perc_ct_1990 <- wayne_aggr1990[,list_race]/wayne_aggr1990$tot

#obliczenie entopii dla każdego obszaru spisowego oraz dodanie jej do obiektu out_ct
out_ct_1990$ent <- apply(perc_ct_1990, 1, entropy)

out_block_1990 <- data.frame(GISJOIN = wayne_1990$GISJOIN, GISJOIN_T = wayne_1990$GISJOIN_T, pop_i = wayne_1990$tot)

#obliczenie odsetka wg ras dla każdego bloku (dane wejsciowe do obliczenia entropii dla bloku)
perc_block_1990 <- wayne_1990[,list_race]/wayne_1990$tot
perc_block_1990[is.na(perc_block_1990)] <- 0

# obliczenie entropii dla każdego bloku 
out_block_1990$ent_i <- apply(perc_block_1990, 1, entropy)

calc_df_1990 <- merge(out_ct_1990, out_block_1990, by="GISJOIN_T")
calc_df_1990 <- calc_df_1990[, c("GISJOIN_T", "GISJOIN", "pop", "pop_i", "ent", "ent_i")]

calc_df_1990$H <- calc_df_1990$pop_i*(calc_df_1990$ent-calc_df_1990$ent_i)/(calc_df_1990$ent*calc_df_1990$pop)

h_index_1990 <- aggregate(H~GISJOIN_T, calc_df_1990, sum)

out_ct_1990 <- merge(out_ct_1990, h_index_1990, by = "GISJOIN_T")
colnames(out_ct_1990) <- c("GISJOIN_T", "tot", "E", "H")

#obliczenie entropii standaryzowanej 
out_ct_1990$Estd <- out_ct_1990$E/log(length(list_race))

out_1990 <- merge(wayne_aggr1990, out_ct_1990[,-2], by="GISJOIN_T")

biv_1990 <-  expand.grid(ent = c("L", "M", "H"), h=c("L", "M", "H"))
biv_1990$biv_cls <- paste(biv_1990$ent,biv_1990$h,  sep="")

out_1990$Estd_cls <- cut(out_1990$Estd, breaks = c(0, 0.33, 0.66, 1), labels = c("L", "M", "H"), include.lowest = TRUE, right = TRUE)
out_1990$H_cls <- cut(out_1990$H, breaks = c(0, 0.33, 0.66, 1), labels = c("L", "M", "H"), include.lowest = TRUE, right = TRUE)
out_1990$biv_cls <- paste(out_1990$Estd_cls, out_1990$H_cls, sep="")

## Zapisanie wyniku

#write.csv(out,"dane\\wayne_aggr_idx_1990.csv")

## Polaczenie wyliczonych danych z danymi przestrzennymi

bnd_attr_1990 <- merge(select(bnd_1990,-any_of(c(list_race,'tot'))), out_1990, by.x = "GISJOIN", by.y = "GISJOIN_T")

## Wizualizacja wkaznikow na mapach

#plot(bnd_attr_1990["H"])
# 
#legenda 
biv_colors = stevens.bluered()
names(biv_colors) = c("LL", "ML", "HL", "LM", "MM", "HM", "LH", "MH", "HH")
# 
plot1 = ggplot(bnd_attr_1990) + 
  geom_sf(aes(fill = biv_cls)) + 
  scale_fill_manual(values = biv_colors) + 
  theme_bw() +
  labs(title = "1990") +
  theme(plot.title = element_text(size = 20, hjust = 0.5))



## Wczytanie danych
wayne_aggr2000 =  read.csv('dane\\wayne_aggr_2000.csv')
wayne_2000 = read.csv('dane\\wayne_2000.csv')
list_race <- c("whites", "blacks", "asians", "native_americans", "others", "latino")
bnd_2000 <- st_read("dane\\wayne.gpkg", layer = "wayne_2000")

wayne_2000$tot = wayne_2000$whites + wayne_2000$blacks + wayne_2000$asians + wayne_2000$native_americans + wayne_2000$others + wayne_2000$latino

## Wczytanie funkcji
entropy = function(pi){
  entropy = -sum(pi*log(pi), na.rm = TRUE)
  return(entropy)}

bivcol = function(pal){
  tit = substitute(pal)
  pal = pal()
  ncol = length(pal)
  image(matrix(seq_along(pal), nrow = sqrt(ncol)),
        axes = FALSE, 
        col = pal, 
        asp = 1)
  mtext(tit)
}


#utworzenie ramki danych zawierajacej identyfikator obszaru spisowego (GISJOINT) oraz ogólną liczbę ludności dla każdego obszaru spisowego. 
out_ct_2000 <- data.frame(GISJOIN_T = wayne_aggr2000$GISJOIN_T, pop = wayne_aggr2000$tot)

#obliczenie odsetka ras dla poszczegolnych obszarow spisowych (dane wejsciowe do obliczenia entropii)
perc_ct_2000 <- wayne_aggr2000[,list_race]/wayne_aggr2000$tot

#obliczenie entopii dla każdego obszaru spisowego oraz dodanie jej do obiektu out_ct
out_ct_2000$ent <- apply(perc_ct_2000, 1, entropy)

out_block_2000 <- data.frame(GISJOIN = wayne_2000$GISJOIN, GISJOIN_T = wayne_2000$GISJOIN_T, pop_i = wayne_2000$tot)

#obliczenie odsetka wg ras dla każdego bloku (dane wejsciowe do obliczenia entropii dla bloku)
perc_block_2000 <- wayne_2000[,list_race]/wayne_2000$tot
perc_block_2000[is.na(perc_block_2000)] <- 0

# obliczenie entropii dla każdego bloku 
out_block_2000$ent_i <- apply(perc_block_2000, 1, entropy)

calc_df_2000 <- merge(out_ct_2000, out_block_2000, by="GISJOIN_T")
calc_df_2000 <- calc_df_2000[, c("GISJOIN_T", "GISJOIN", "pop", "pop_i", "ent", "ent_i")]

calc_df_2000$H <- calc_df_2000$pop_i*(calc_df_2000$ent-calc_df_2000$ent_i)/(calc_df_2000$ent*calc_df_2000$pop)

h_index_2000 <- aggregate(H~GISJOIN_T, calc_df_2000, sum)

out_ct_2000 <- merge(out_ct_2000, h_index_2000, by = "GISJOIN_T")
colnames(out_ct_2000) <- c("GISJOIN_T", "tot", "E", "H")

#obliczenie entropii standaryzowanej 
out_ct_2000$Estd <- out_ct_2000$E/log(length(list_race))

out_2000 <- merge(wayne_aggr2000, out_ct_2000[,-2], by="GISJOIN_T")

biv_2000 <-  expand.grid(ent = c("L", "M", "H"), h=c("L", "M", "H"))
biv_2000$biv_cls <- paste(biv_2000$ent,biv_2000$h,  sep="")

out_2000$Estd_cls <- cut(out_2000$Estd, breaks = c(0, 0.33, 0.66, 1), labels = c("L", "M", "H"), include.lowest = TRUE, right = TRUE)
out_2000$H_cls <- cut(out_2000$H, breaks = c(0, 0.33, 0.66, 1), labels = c("L", "M", "H"), include.lowest = TRUE, right = TRUE)
out_2000$biv_cls <- paste(out_2000$Estd_cls, out_2000$H_cls, sep="")

## Zapisanie wyniku

#write.csv(out,"dane\\wayne_aggr_idx_2000.csv")

## Polaczenie wyliczonych danych z danymi przestrzennymi

bnd_attr_2000 <- merge(select(bnd_2000,-any_of(c(list_race,'tot'))), out_2000, by.x = "GISJOIN", by.y = "GISJOIN_T")

## Wizualizacja wkaznikow na mapach

#plot(bnd_attr_2000["H"])
# 
#legenda 
biv_colors = stevens.bluered()
names(biv_colors) = c("LL", "ML", "HL", "LM", "MM", "HM", "LH", "MH", "HH")
# 
plot2 = ggplot(bnd_attr_2000) + 
  geom_sf(aes(fill = biv_cls)) + 
  scale_fill_manual(values = biv_colors) + 
  theme_bw() +
  labs(title = "2000") +
  theme(plot.title = element_text(size = 20, hjust = 0.5))




## Wczytanie danych
wayne_aggr2010 =  read.csv('dane\\wayne_aggr_2010.csv')
wayne_2010 = read.csv('dane\\wayne_2010.csv')
list_race <- c("whites", "blacks", "asians", "native_americans", "others", "latino")
bnd_2010 <- st_read("dane\\wayne.gpkg", layer = "wayne_2010")

wayne_2010$tot = wayne_2010$whites + wayne_2010$blacks + wayne_2010$asians + wayne_2010$native_americans + wayne_2010$others + wayne_2010$latino

## Wczytanie funkcji
entropy = function(pi){
  entropy = -sum(pi*log(pi), na.rm = TRUE)
  return(entropy)}

bivcol = function(pal){
  tit = substitute(pal)
  pal = pal()
  ncol = length(pal)
  image(matrix(seq_along(pal), nrow = sqrt(ncol)),
        axes = FALSE, 
        col = pal, 
        asp = 1)
  mtext(tit)
}


#utworzenie ramki danych zawierajacej identyfikator obszaru spisowego (GISJOINT) oraz ogólną liczbę ludności dla każdego obszaru spisowego. 
out_ct_2010 <- data.frame(GISJOIN_T = wayne_aggr2010$GISJOIN_T, pop = wayne_aggr2010$tot)

#obliczenie odsetka ras dla poszczegolnych obszarow spisowych (dane wejsciowe do obliczenia entropii)
perc_ct_2010 <- wayne_aggr2010[,list_race]/wayne_aggr2010$tot

#obliczenie entopii dla każdego obszaru spisowego oraz dodanie jej do obiektu out_ct
out_ct_2010$ent <- apply(perc_ct_2010, 1, entropy)

out_block_2010 <- data.frame(GISJOIN = wayne_2010$GISJOIN, GISJOIN_T = wayne_2010$GISJOIN_T, pop_i = wayne_2010$tot)

#obliczenie odsetka wg ras dla każdego bloku (dane wejsciowe do obliczenia entropii dla bloku)
perc_block_2010 <- wayne_2010[,list_race]/wayne_2010$tot
perc_block_2010[is.na(perc_block_2010)] <- 0

# obliczenie entropii dla każdego bloku 
out_block_2010$ent_i <- apply(perc_block_2010, 1, entropy)

calc_df_2010 <- merge(out_ct_2010, out_block_2010, by="GISJOIN_T")
calc_df_2010 <- calc_df_2010[, c("GISJOIN_T", "GISJOIN", "pop", "pop_i", "ent", "ent_i")]

calc_df_2010$H <- calc_df_2010$pop_i*(calc_df_2010$ent-calc_df_2010$ent_i)/(calc_df_2010$ent*calc_df_2010$pop)

h_index_2010 <- aggregate(H~GISJOIN_T, calc_df_2010, sum)

out_ct_2010 <- merge(out_ct_2010, h_index_2010, by = "GISJOIN_T")
colnames(out_ct_2010) <- c("GISJOIN_T", "tot", "E", "H")

#obliczenie entropii standaryzowanej 
out_ct_2010$Estd <- out_ct_2010$E/log(length(list_race))

out_2010 <- merge(wayne_aggr2010, out_ct_2010[,-2], by="GISJOIN_T")

biv_2010 <-  expand.grid(ent = c("L", "M", "H"), h=c("L", "M", "H"))
biv_2010$biv_cls <- paste(biv_2010$ent,biv_2010$h,  sep="")

out_2010$Estd_cls <- cut(out_2010$Estd, breaks = c(0, 0.33, 0.66, 1), labels = c("L", "M", "H"), include.lowest = TRUE, right = TRUE)
out_2010$H_cls <- cut(out_2010$H, breaks = c(0, 0.33, 0.66, 1), labels = c("L", "M", "H"), include.lowest = TRUE, right = TRUE)
out_2010$biv_cls <- paste(out_2010$Estd_cls, out_2010$H_cls, sep="")

## Zapisanie wyniku

#write.csv(out,"dane\\wayne_aggr_idx_2010.csv")

## Polaczenie wyliczonych danych z danymi przestrzennymi

bnd_attr_2010 <- merge(select(bnd_2010,-any_of(c(list_race,'tot'))), out_2010, by.x = "GISJOIN", by.y = "GISJOIN_T")

## Wizualizacja wkaznikow na mapach

#plot(bnd_attr_2010["H"])
# 
#legenda 
biv_colors = stevens.bluered()
names(biv_colors) = c("LL", "ML", "HL", "LM", "MM", "HM", "LH", "MH", "HH")
# 
plot3 = ggplot(bnd_attr_2010) + 
  geom_sf(aes(fill = biv_cls)) + 
  scale_fill_manual(values = biv_colors) + 
  theme_bw() +
  labs(title = "2010") +
  theme(plot.title = element_text(size = 20, hjust = 0.5))




## Wczytanie danych
wayne_aggr2020 =  read.csv('dane\\wayne_aggr_2020.csv')
wayne_2020 = read.csv('dane\\wayne_2020.csv')
list_race <- c("whites", "blacks", "asians", "native_americans", "others", "latino")
bnd_2020 <- st_read("dane\\wayne.gpkg", layer = "wayne_2020")

wayne_2020$tot = wayne_2020$whites + wayne_2020$blacks + wayne_2020$asians + wayne_2020$native_americans + wayne_2020$others + wayne_2020$latino

## Wczytanie funkcji
entropy = function(pi){
  entropy = -sum(pi*log(pi), na.rm = TRUE)
  return(entropy)}

bivcol = function(pal){
  tit = substitute(pal)
  pal = pal()
  ncol = length(pal)
  image(matrix(seq_along(pal), nrow = sqrt(ncol)),
        axes = FALSE, 
        col = pal, 
        asp = 1)
  mtext(tit)
}


#utworzenie ramki danych zawierajacej identyfikator obszaru spisowego (GISJOINT) oraz ogólną liczbę ludności dla każdego obszaru spisowego. 
out_ct_2020 <- data.frame(GISJOIN_T = wayne_aggr2020$GISJOIN_T, pop = wayne_aggr2020$tot)

#obliczenie odsetka ras dla poszczegolnych obszarow spisowych (dane wejsciowe do obliczenia entropii)
perc_ct_2020 <- wayne_aggr2020[,list_race]/wayne_aggr2020$tot

#obliczenie entopii dla każdego obszaru spisowego oraz dodanie jej do obiektu out_ct
out_ct_2020$ent <- apply(perc_ct_2020, 1, entropy)

out_block_2020 <- data.frame(GISJOIN = wayne_2020$GISJOIN, GISJOIN_T = wayne_2020$GISJOIN_T, pop_i = wayne_2020$tot)

#obliczenie odsetka wg ras dla każdego bloku (dane wejsciowe do obliczenia entropii dla bloku)
perc_block_2020 <- wayne_2020[,list_race]/wayne_2020$tot
perc_block_2020[is.na(perc_block_2020)] <- 0

# obliczenie entropii dla każdego bloku 
out_block_2020$ent_i <- apply(perc_block_2020, 1, entropy)

calc_df_2020 <- merge(out_ct_2020, out_block_2020, by="GISJOIN_T")
calc_df_2020 <- calc_df_2020[, c("GISJOIN_T", "GISJOIN", "pop", "pop_i", "ent", "ent_i")]

calc_df_2020$H <- calc_df_2020$pop_i*(calc_df_2020$ent-calc_df_2020$ent_i)/(calc_df_2020$ent*calc_df_2020$pop)

h_index_2020 <- aggregate(H~GISJOIN_T, calc_df_2020, sum)

out_ct_2020 <- merge(out_ct_2020, h_index_2020, by = "GISJOIN_T")
colnames(out_ct_2020) <- c("GISJOIN_T", "tot", "E", "H")

#obliczenie entropii standaryzowanej 
out_ct_2020$Estd <- out_ct_2020$E/log(length(list_race))

out_2020 <- merge(wayne_aggr2020, out_ct_2020[,-2], by="GISJOIN_T")

biv_2020 <-  expand.grid(ent = c("L", "M", "H"), h=c("L", "M", "H"))
biv_2020$biv_cls <- paste(biv_2020$ent,biv_2020$h,  sep="")

out_2020$Estd_cls <- cut(out_2020$Estd, breaks = c(0, 0.33, 0.66, 1), labels = c("L", "M", "H"), include.lowest = TRUE, right = TRUE)
out_2020$H_cls <- cut(out_2020$H, breaks = c(0, 0.33, 0.66, 1), labels = c("L", "M", "H"), include.lowest = TRUE, right = TRUE)
out_2020$biv_cls <- paste(out_2020$Estd_cls, out_2020$H_cls, sep="")

## Zapisanie wyniku

#write.csv(out,"dane\\wayne_aggr_idx_2020.csv")

## Polaczenie wyliczonych danych z danymi przestrzennymi

bnd_attr_2020 <- merge(select(bnd_2020,-any_of(c(list_race,'tot'))), out_2020, by.x = "GISJOIN", by.y = "GISJOIN_T")

## Wizualizacja wkaznikow na mapach

#plot(bnd_attr_2020["H"])
# 
#legenda 
biv_colors = stevens.bluered()
names(biv_colors) = c("LL", "ML", "HL", "LM", "MM", "HM", "LH", "MH", "HH")
# 
plot4 = ggplot(bnd_attr_2020) + 
  geom_sf(aes(fill = biv_cls)) + 
  scale_fill_manual(values = biv_colors) + 
  theme_bw() +
  labs(title = "2020") +
  theme(plot.title = element_text(size = 20, hjust = 0.5))


combined_plot1 <- plot1 + plot2 + plot3 + plot4 + plot_layout(ncol = 2)
combined_plot1

Rycina przedstawia zróżnicowanie struktury rasowo-etnicznej ludności w latach 1990-2020. Dla każdego dziesięciolecia zostały wyróżnione typy struktury oznaczone dwiema literami. Pierwsza oznacza różnorodność (diversity), natomiast druga stopień segregacji (segregation).

3.2 Mapa zmian między rokiem 1990-2000, 2000-2010, 2010-2020, 1990-2020

list_race <- c("whites", "blacks", "asians", "native_americans", "others", "latino")

wayne_stb_1990 = st_read("dane//wayne.gpkg", layer = 'wayne_stb_1990')
wayne_stb_2000 = st_read("dane//wayne.gpkg", layer = 'wayne_stb_2000')

cls_df = data.frame(GISJOIN = wayne_stb_1990$GISJOIN,
                    cls1990 = wayne_stb_1990$race_cls,
                    cls2000 = wayne_stb_2000$race_cls)

st_geometry(cls_df)<-wayne_stb_2000$geom

#table(cls_df$cls1990)
#table(cls_df$cls2000)

tab1990 <- prop.table(table(cls_df$cls1990))*100
round(tab1990, 1)

tab2000 <- prop.table(table(cls_df$cls2000))*100
round(tab2000, 1)

tab <- table(cls_df$cls1990, cls_df$cls2000)
tab

rowSums(tab)
colSums(tab)

round(prop.table(table(cls_df$cls1990, cls_df$cls2000))*100, 1)

#plot(cls_df["cls1990"])
#plot(cls_df["cls2000"])


cls_color <- c("AL"= "#CD5555", "AM"= "#FF6A6A", "BL"= "#006400", "BM"= "#32CD32", "HD"= "#8F8F8F", "HL"= "#5D478B", "HM"= "#9370DB", "WL"= "#FF8C00", "WM"= "#FFD700")

col1990 <- cls_color[names(cls_color)%in%unique(cls_df$cls1990)]
col2000 <- cls_color[names(cls_color)%in%unique(cls_df$cls2000)]


p1 <- ggplot(data = cls_df) +
  geom_sf(aes(fill = cls1990)) +
  scale_fill_manual(values = col1990) + 
  labs(title = "Wayne, 1990") + 
  theme_bw() +
  theme(legend.position="bottom")

p2 <- ggplot(data = cls_df) +
  geom_sf(aes(fill = cls2000)) +
  scale_fill_manual(values = col2000) + 
  labs(title = "Wayne, 2000") + 
  theme_bw() +
  theme(legend.position="bottom")


#wyswietlenie wykresow obok siebie
p1 + p2 + plot_annotation(title = "Zmiany między rokiem 1990-2000", theme = theme(plot.title = element_text(size = 20, hjust = 0.5)))

W roku 1990 dominującym typem struktury obserwowanym w hrabstwie jest LL. Oznacza to w praktyce niewielkie zróżnicowanie rasowe na większości badanego obszaru, jak i również wysoką integrację pomiędzy populacją różnych ras. Największe zróżnicowanie rasowe zauważalne jest zwłaszcza w mieście Detroit oraz w jego pobliżu. W roku 2000 zróżnicowanie rasowe wzrosło, natomiast stopień segregacji rasowej zmalał.

list_race <- c("whites", "blacks", "asians", "native_americans", "others", "latino")

wayne_stb_2000 = st_read("dane//wayne.gpkg", layer = 'wayne_stb_2000')
wayne_stb_2010 = st_read("dane//wayne.gpkg", layer = 'wayne_stb_2010')

cls_df = data.frame(GISJOIN = wayne_stb_2000$GISJOIN,
                    cls2000 = wayne_stb_2000$race_cls,
                    cls2010 = wayne_stb_2010$race_cls)

st_geometry(cls_df)<-wayne_stb_2010$geom

#table(cls_df$cls2000)
#table(cls_df$cls2010)

tab2000 <- prop.table(table(cls_df$cls2000))*100
round(tab2000, 1)

tab2010 <- prop.table(table(cls_df$cls2010))*100
round(tab2010, 1)

tab <- table(cls_df$cls2000, cls_df$cls2010)
tab

rowSums(tab)
colSums(tab)

round(prop.table(table(cls_df$cls2000, cls_df$cls2010))*100, 1)

#plot(cls_df["cls2000"])
#plot(cls_df["cls2010"])


cls_color <- c("AL"= "#CD5555", "AM"= "#FF6A6A", "BL"= "#006400", "BM"= "#32CD32", "HD"= "#8F8F8F", "HL"= "#5D478B", "HM"= "#9370DB", "WL"= "#FF8C00", "WM"= "#FFD700")

col2000 <- cls_color[names(cls_color)%in%unique(cls_df$cls2000)]
col2010 <- cls_color[names(cls_color)%in%unique(cls_df$cls2010)]


p1 <- ggplot(data = cls_df) +
  geom_sf(aes(fill = cls2000)) +
  scale_fill_manual(values = col2000) + 
  labs(title = "Wayne, 2000") + 
  theme_bw() +
  theme(legend.position="bottom")

p2 <- ggplot(data = cls_df) +
  geom_sf(aes(fill = cls2010)) +
  scale_fill_manual(values = col2010) + 
  labs(title = "Wayne, 2010") + 
  theme_bw() +
  theme(legend.position="bottom")


#wyswietlenie wykresow obok siebie
p1 + p2 + plot_annotation(title = "Zmiany między rokiem 2000-2010", theme = theme(plot.title = element_text(size = 20, hjust = 0.5)))

W roku 2010 największą zmianę możemy zauważyć w zachodniej części obszaru, gdzie zróżnicowanie rasowe wyraźnie wzrosło, a około połowa hrabstwa jest oznaczona jako społeczeństwa o wysokim bądź średnim zróżnicowaniu rasowym. Wysokie zróżnicowanie rasowe występuje szczególnie w okolicach Detroit. Poziom segregacji rasowej przeważnie nie wykazuje wartości wyższych niż średnia, z wyjątkiem pojedynczego obszaru o średnim poziomie zróżnicowania rasowego oraz wysoką segregacją.

list_race <- c("whites", "blacks", "asians", "native_americans", "others", "latino")

wayne_stb_2010 = st_read("dane//wayne.gpkg", layer = 'wayne_stb_2010')
wayne_stb_2020 = st_read("dane//wayne.gpkg", layer = 'wayne_stb_2020')

cls_df = data.frame(GISJOIN = wayne_stb_2010$GISJOIN,
                    cls2010 = wayne_stb_2010$race_cls,
                    cls2020 = wayne_stb_2020$race_cls)

st_geometry(cls_df)<-wayne_stb_2020$geom

#table(cls_df$cls2010)
#table(cls_df$cls2020)

tab2010 <- prop.table(table(cls_df$cls2010))*100
round(tab2010, 1)

tab2020 <- prop.table(table(cls_df$cls2020))*100
round(tab2020, 1)

tab <- table(cls_df$cls2010, cls_df$cls2020)
tab

rowSums(tab)
colSums(tab)

round(prop.table(table(cls_df$cls2010, cls_df$cls2020))*100, 1)

#plot(cls_df["cls2010"])
#plot(cls_df["cls2020"])


cls_color <- c("AL"= "#CD5555", "AM"= "#FF6A6A", "BL"= "#006400", "BM"= "#32CD32", "HD"= "#8F8F8F", "HL"= "#5D478B", "HM"= "#9370DB", "WL"= "#FF8C00", "WM"= "#FFD700")

col2010 <- cls_color[names(cls_color)%in%unique(cls_df$cls2010)]
col2020 <- cls_color[names(cls_color)%in%unique(cls_df$cls2020)]


p1 <- ggplot(data = cls_df) +
  geom_sf(aes(fill = cls2010)) +
  scale_fill_manual(values = col2010) + 
  labs(title = "Wayne, 2010") + 
  theme_bw() +
  theme(legend.position="bottom")

p2 <- ggplot(data = cls_df) +
  geom_sf(aes(fill = cls2020)) +
  scale_fill_manual(values = col2020) + 
  labs(title = "Wayne, 2020") + 
  theme_bw() +
  theme(legend.position="bottom")


#wyswietlenie wykresow obok siebie
p1 + p2 + plot_annotation(title = "Zmiany między rokiem 2010-2020", theme = theme(plot.title = element_text(size = 20, hjust = 0.5)))

Rok 2020 wykazuje najwyższy, bo zajmujący większość obszaru hrabstwa, stopień zróżnicowania rasowego spośród wszystkich omawianych okresów. Jedyne obszary, które na przestrzeni lat wykazywały niewielkie zmiany (bądź nie wykazywały ich wcale) to centralna oraz wschodnia północ, gdzie zarówno zróżnicowanie rasowe, jak i segregacja są niskie, co oznacza, że dominująca jest tam tylko jedna rasa.

list_race <- c("whites", "blacks", "asians", "native_americans", "others", "latino")

wayne_stb_1990 = st_read("dane//wayne.gpkg", layer = 'wayne_stb_1990')
wayne_stb_2020 = st_read("dane//wayne.gpkg", layer = 'wayne_stb_2020')

cls_df = data.frame(GISJOIN = wayne_stb_1990$GISJOIN,
                    cls1990 = wayne_stb_1990$race_cls,
                    cls2020 = wayne_stb_2020$race_cls)

st_geometry(cls_df)<-wayne_stb_2020$geom

#table(cls_df$cls1990)
#table(cls_df$cls2020)

tab1990 <- prop.table(table(cls_df$cls1990))*100
round(tab1990, 1)

tab2020 <- prop.table(table(cls_df$cls2020))*100
round(tab2020, 1)

tab <- table(cls_df$cls1990, cls_df$cls2020)
tab

rowSums(tab)
colSums(tab)

round(prop.table(table(cls_df$cls1990, cls_df$cls2020))*100, 1)

#plot(cls_df["cls1990"])
#plot(cls_df["cls2020"])


cls_color <- c("AL"= "#CD5555", "AM"= "#FF6A6A", "BL"= "#006400", "BM"= "#32CD32", "HD"= "#8F8F8F", "HL"= "#5D478B", "HM"= "#9370DB", "WL"= "#FF8C00", "WM"= "#FFD700")

col1990 <- cls_color[names(cls_color)%in%unique(cls_df$cls1990)]
col2020 <- cls_color[names(cls_color)%in%unique(cls_df$cls2020)]


p1 <- ggplot(data = cls_df) +
  geom_sf(aes(fill = cls1990)) +
  scale_fill_manual(values = col1990) + 
  labs(title = "Wayne, 1990") + 
  theme_bw() +
  theme(legend.position="bottom")

p2 <- ggplot(data = cls_df) +
  geom_sf(aes(fill = cls2020)) +
  scale_fill_manual(values = col2020) + 
  labs(title = "Wayne, 2020") + 
  theme_bw() +
  theme(legend.position="bottom")


#wyswietlenie wykresow obok siebie
p1 + p2 + plot_annotation(title = "Zmiany między rokiem 1990-2020", theme = theme(plot.title = element_text(size = 20, hjust = 0.5)))

Zróżnicowanie rasowe oraz segregacja rasowa na przestrzeni omawianego trzydziestolecia zmieniły się głównie w zachodniej oraz centralnej części hrabstwa Wayne, a także w mieście Detroit oraz jego okolicach. Północna część w większości pozostawała bez zmian - przez cały badany okres przeważała tam głównie ludność czarna. W centrum i na zachodzie najwięcej występowało tam populacji białej, jednak z biegiem lat ich większość stawała się coraz mniejsza na coraz większej ilości obszarów spisowych. W roku 1990 znacząca większość obszarów była zdominowana (powyżej 80%) przez ludność białą, a w roku 2020 w niektórych okręgach ich przewaga spadła, została zastąpiona przewagą ludności czarnej, a nawet wystąpiły obszary spisowe, w których nie została określona dominacja żadnej rasy. W okolicach Detroit pojawił się duży obszar zdominowany przez Latynosów, a w 2020 na północy hrabstwa wystąpiły dwa obszary zdominowane przez Azjatów.

3.3. Ilość obszarów spisowych występujących w danym typie struktury rasowo-etnicznej w danym roku.

library(kableExtra)
cls_color <- c("#FF8C00", "#FFD700", "#006400", "#32CD32", "#CD5555", "#FF6A6A", "#5D478B", "#9370DB", "#8F8F8F")
data_p <- data.frame(
race_str = c("WL", "WM", "BL", "BM", "AL", "AM", "HL", "HM", "HD"),
  r_1990 = c(335, 46, 174, 58, 0, 0, 0, 1, 11),
  r_2000 = c(261, 75, 208, 48, 0, 0, 0, 11, 22),
  r_2010 = c(210, 107, 222, 43, 0, 0, 0, 18, 25),
  r_2020 = c(125, 151, 201, 61, 0, 2, 5, 10, 70)
)

data_p %>%
  kbl() %>%
  kable_classic_2(full_width = F) %>%
  column_spec(1, background = cls_color)

race_str	r_1990	r_2000	r_2010	r_2020
WL	335	261	210	125
WM	46	75	107	151
BL	174	208	222	201
BM	58	48	43	61
AL	0	0	0	0
AM	0	0	0	2
HL	0	0	0	5
HM	1	11	18	10
HD	11	22	25	70

Macierz przejść obrazuje nam ilość obszarów spisowych zdominowanych przez daną rasę w podanym roku. Pierwszą zauważalną informacją jest, że w każdym badanym roku przeważa ludność biała, jednak jej przewaga z roku na rok maleje. Obszarów zdominowanych przez białych w powyżej 80% po 30 latach jest niemal trzykrotnie mniej (o 210 mniej), jednak mimo tego wciąż po 3 dekadach jest ich powyżej 50% w 151 obszarach spisowych. Dużo jest również obszarów zdominowanych przez ludność czarną, a liczby te rosną, a w szczególności rośnie ilość obszarów z przewagą osób czarnoskórych powyżej 80%. Istnieje bardzo niewiele obszarów zdominowanych przez Azjatów - w badanym okresie wyszczególniono tylko 2 obszary z przewagą ludności azjatyckiej, zauważone w 2020 roku. Obszarów spisowych, w których przeważa ludność Latynoska jest stosunkowo niewiele, jednak, podobnie jak w przypadku ludności czarnej, z roku na rok rośnie. W roku 2020 w okolicach Detroit pierwszy raz zauważono dominację Latynosów z przewagą powyżej 80% na aż pięciu obszarach. Rośnie również ilość obszarów, na których nie występuje dominacja żadnej rasy, co jest dowodem na rosnące zróżnicowanie rasowe społeczeństwa w hrabstwie Wayne.

3.4. Macierz przejść pokazująca zmiany w typach między rokiem 1990-2000, 2000-2010, 2010-2020, 1990-2020

# Wczytanie danych dla roku 1990 i 2000
wayne_1990 <- st_read("dane//wayne.gpkg", layer = "wayne_stb_1990")
wayne_2000 <- st_read("dane//wayne.gpkg", layer = "wayne_stb_2000")


wayne_1990 = st_drop_geometry(wayne_1990)
wayne_1990 = select(wayne_1990, 1,'race_cls')
wayne_1990 = rename(wayne_1990, race_cls_1990 = race_cls) 

wayne_2000 = st_drop_geometry(wayne_2000)
wayne_2000 = select(wayne_2000, 1,'race_cls')
wayne_2000 = rename(wayne_2000, race_cls_2000 = race_cls) 

wayne_1990_2000 = merge(wayne_1990, wayne_2000, by = "GISJOIN")

 table(wayne_1990_2000$race_cls_1990)

 table(wayne_1990_2000$race_cls_2000)

trans_matrix1 = table(wayne_1990_2000$race_cls_1990, wayne_1990_2000$race_cls_2000)
trans_matrix1


t1 = trans_matrix1 %>%
  kbl(caption = "<span style='font-size:20px'>Macierz przejść między rokiem 1990-2000</span>") %>%
  kable_classic_2(full_width = F) %>%
  kable_styling(bootstrap_options = "striped", latex_options = "scale_down") %>%
  column_spec(1, bold = TRUE, color = "white", background = "#333") %>%
  row_spec(0, bold = TRUE, color = "white", background = "#333") %>%
  column_spec(2:7, bold = TRUE, color = "white", background = "gray")


# Wczytanie danych dla roku 2000 i 2010
wayne_2000 <- st_read("dane//wayne.gpkg", layer = "wayne_stb_2000")
wayne_2010 <- st_read("dane//wayne.gpkg", layer = "wayne_stb_2010")


wayne_2000 = st_drop_geometry(wayne_2000)
wayne_2000 = select(wayne_2000, 1,'race_cls')
wayne_2000 = rename(wayne_2000, race_cls_2000 = race_cls) 

wayne_2010 = st_drop_geometry(wayne_2010)
wayne_2010 = select(wayne_2010, 1,'race_cls')
wayne_2010 = rename(wayne_2010, race_cls_2010 = race_cls) 

wayne_2000_2010 = merge(wayne_2000, wayne_2010, by = "GISJOIN")

 table(wayne_2000_2010$race_cls_2000)

 table(wayne_2000_2010$race_cls_2010)

trans_matrix2 = table(wayne_2000_2010$race_cls_2000, wayne_2000_2010$race_cls_2010)


t2 = trans_matrix2 %>%
  kbl(caption = "<span style='font-size:20px'>Macierz przejść między rokiem 2000-2010</span>") %>%
  kable_classic_2(full_width = F) %>%
  kable_styling(bootstrap_options = "striped", latex_options = "scale_down") %>%
  column_spec(1, bold = TRUE, color = "white", background = "#333") %>%
  row_spec(0, bold = TRUE, color = "white", background = "#333") %>%
  column_spec(2:7, bold = TRUE, color = "white", background = "gray")



# Wczytanie danych dla roku 2010 i 2020
wayne_2010 <- st_read("dane//wayne.gpkg", layer = "wayne_stb_2010")
wayne_2020 <- st_read("dane//wayne.gpkg", layer = "wayne_stb_2020")


wayne_2010 = st_drop_geometry(wayne_2010)
wayne_2010 = select(wayne_2010, 1,'race_cls')
wayne_2010 = rename(wayne_2010, race_cls_2010 = race_cls) 

wayne_2020 = st_drop_geometry(wayne_2020)
wayne_2020 = select(wayne_2020, 1,'race_cls')
wayne_2020 = rename(wayne_2020, race_cls_2020 = race_cls) 

wayne_2010_2020 = merge(wayne_2010, wayne_2020, by = "GISJOIN")

 table(wayne_2010_2020$race_cls_2010)

 table(wayne_2010_2020$race_cls_2020)

trans_matrix3 = table(wayne_2010_2020$race_cls_2010, wayne_2010_2020$race_cls_2020)



t3 = trans_matrix3 %>%
  kbl(caption = "<span style='font-size:20px'>Macierz przejść między rokiem 2010-2020</span>") %>%
  kable_classic_2(full_width = F) %>%
  kable_styling(bootstrap_options = "striped", latex_options = "scale_down") %>%
  column_spec(1, bold = TRUE, color = "white", background = "#333") %>%
  row_spec(0, bold = TRUE, color = "white", background = "#333") %>%
  column_spec(2:9, bold = TRUE, color = "white", background = "gray")



# Wczytanie danych dla roku 1990 i 2020
wayne_1990 <- st_read("dane//wayne.gpkg", layer = "wayne_stb_1990")
wayne_2020 <- st_read("dane//wayne.gpkg", layer = "wayne_stb_2020")


wayne_1990 = st_drop_geometry(wayne_1990)
wayne_1990 = select(wayne_1990, 1,'race_cls')
wayne_1990 = rename(wayne_1990, race_cls_1990 = race_cls) 

wayne_2020 = st_drop_geometry(wayne_2020)
wayne_2020 = select(wayne_2020, 1,'race_cls')
wayne_2020 = rename(wayne_2020, race_cls_2020 = race_cls) 

wayne_1990_2020 = merge(wayne_1990, wayne_2020, by = "GISJOIN")

 table(wayne_1990_2020$race_cls_1990)

 table(wayne_1990_2020$race_cls_2020)

trans_matrix4 = table(wayne_1990_2020$race_cls_1990, wayne_1990_2020$race_cls_2020)



t4 = trans_matrix4 %>%
  kbl(caption = "<span style='font-size:20px'>Macierz przejść między rokiem 1990-2020</span>") %>%
  kable_classic_2(full_width = F) %>%
  kable_styling(bootstrap_options = "striped", latex_options = "scale_down") %>%
  column_spec(1, bold = TRUE, color = "white", background = "#333") %>%
  row_spec(0, bold = TRUE, color = "white", background = "#333") %>%
  column_spec(2:9, bold = TRUE, color = "white", background = "gray")

# Łączenie tabel
library(htmltools)

## Warning: pakiet 'htmltools' został zbudowany w wersji R 4.3.3

combined_tables <- HTML(paste(
  '<div style="display: grid; grid-template-columns: 1fr 1fr; gap: 1px; row-gap: 20px; column-gap: 1px">',
  '<div>', t1, '</div>',
  '<div>', t2, '</div>',
  '<div>', t3, '</div>',
  '<div>', t4, '</div>',
  '</div>'
))

# Wyświetlanie
browsable(tagList(combined_tables))

Macierz przejść między rokiem 1990-2000
	BL	BM	HD	HM	WL	WM
BL	173	1	0	0	0	0
BM	30	26	1	0	1	0
HD	2	2	4	3	0	0
HM	0	0	0	1	0	0
WL	0	7	3	0	259	66
WM	3	12	14	7	1	9

Macierz przejść między rokiem 2000-2010
	BL	BM	HD	HM	WL	WM
BL	204	3	1	0	0	0
BM	17	26	3	0	0	2
HD	1	5	8	7	0	1
HM	0	0	0	11	0	0
WL	0	1	2	0	199	59
WM	0	8	11	0	11	45

Macierz przejść między rokiem 2010-2020
	AM	BL	BM	HD	HL	HM	WL	WM
BL	0	197	24	1	0	0	0	0
BM	0	4	24	12	0	0	0	3
HD	1	0	7	12	0	1	0	4
HM	0	0	0	3	5	9	0	1
WL	0	0	1	13	0	0	123	73
WM	1	0	5	29	0	0	2	70

Macierz przejść między rokiem 1990-2020
	AM	BL	BM	HD	HL	HM	WL	WM
BL	0	153	20	1	0	0	0	0
BM	1	28	15	10	0	0	0	4
HD	0	2	1	3	1	2	0	2
HM	0	0	0	0	1	0	0	0
WL	1	7	16	48	0	0	124	139
WM	0	11	9	8	3	8	1	6

W pierwszej dekadzie badanego okresu nie wykazało zbyt dużo zmian. Dalej dominującą rasą w hrabstwie była ludność biała, przy jednoczesnej wysokiej ilości obszarów spisowych z większością czarnoskórą. Główną zauważalną zmianą jest przejście 30 obszarów o dominacji >50% ludności czarnej na >80%. Wiele obszarów również odczuło spadek odsetka ludności białej na rzecz Latynosów i Czarnych. W następnym dziesięcioleciu wartym uwagi jest przede wszystkim spadek dominacji ludności białej - obszarów o odsetku Białych powyżej 80% ubyło aż 60. Więcej natomiast obszarów ma znaczną przewagę w ilości ludności czarnej. W roku 2020 pojawiły się pierwsze obszary zdominowane przez pudność azjatycką, jednak wciąż takowych występują tylko 2. Wraz ze spadającym udziałem dominacji ludności białej rośnie odsetek latynosów w większości obszarów (głównie obszary Detroit), a także pojawia się znacznie więcej obszarów o braku dominacji którejkolwiek z ras.

4. Wykorzystanie metod analizy krajobrazowej w analizie rasowo-etnicznej struktury ludności

4.1 Metryki krajobrazowe

Metryki krajobrazowe dostarczają informacje na temat przestrzennego rozkładu struktury rasowo-etnicznej. W celu dokonania analizy zostały obliczone 4 metryki krajobrazowe:

• np - liczba płatów

• lpi - stosunek powierzchni największego płata danego typu do powierzchni całego obszaru

• PLAND - procent obszaru zajęty przez dany typ zróżnicowania

• AI - poziom agregacji (0 – pełne rozproszenie, komórki tego samego typu nie graniczą ze sobą; 100 – jeden płat danego typu)

wayne_stb_1990$cls90 = recode(wayne_stb_1990$race_cls, "WL"= 1, "WM" = 2, "BL" = 3, "BM" = 4, "AL" = 5, "AM" = 6, "HL" = 7, "HM" = 8, "HD" = 9)

rast90 <- raster(wayne_stb_1990, res = 100)
# rast90

cls90 = fasterize(wayne_stb_1990, rast90, field = "cls90", fun="sum")

cls_color <- c("#FF8C00", "#FFD700", "#006400", "#32CD32", "#CD5555", "#FF6A6A", "#5D478B", "#9370DB", "#8F8F8F")

# plot(cls90, col = cls_color)


class_metr = list_lsm(level = "class")

lm90 = calculate_lsm(cls90, level = ("class"), what = c("lsm_c_np", "lsm_c_lpi",  "lsm_c_pland", "lsm_c_ai"))

lm_df90 = pivot_wider(lm90[, c("class", "metric", "value")], names_from = metric, values_from = value)

# lm_df90

cls_code90 = data.frame(cls90 = c("WL", "WM", "BL", "BM", "AL", "AM", "HL", "HM", "HD"), class = 1:9)
results90 = merge(cls_code90, lm_df90, by = "class", all.x = TRUE)


# write.csv(results00, "dane/landscape_metrics_2000.csv", row.names = FALSE)


np90 = lsm_l_np(cls90)
# np90

lpi90 = lsm_l_lpi(cls90)
# lpi90

plot(cls90, col = cls_color, main = "1990")

results90 %>%
  kbl() %>%
  kable_classic_2(full_width = F) %>%
  column_spec(1, background = cls_color)

class	cls90	ai	lpi	np	pland
1	WL	99.30027	66.1031995	24	70.3879671
2	WM	96.35258	2.9613283	21	9.1252923
3	BL	98.29305	12.4091972	5	13.8270339
4	BM	93.55324	1.9960991	14	5.6694715
5	AL	NA	NA	NA	NA
6	AM	NA	NA	NA	NA
7	HL	NA	NA	NA	NA
8	HM	93.38843	0.0431352	1	0.0431352
9	HD	93.29268	0.2969455	8	0.9470999

W 1990r. dominuje przeważająco ludność biała, zajmując łącznie 79,5% obszaru oraz mając najwięcej płatów, zaraz za nią plasuje się ludność czarna zajmując ok. 19,5%. Najmniej ma kolejno ludność o dużym zróżnicowaniu oraz Latynosi. Brak danych dla ludności azjatyckiej (lub brak takiej ludności). Agregacja jest bardzo wysoka - płaty mają znikome rozproszenie.

wayne_stb_2000$cls00 = recode(wayne_stb_2000$race_cls, "WL"= 1, "WM" = 2, "BL" = 3, "BM" = 4, "AL" = 5, "AM" = 6, "HL" = 7, "HM" = 8, "HD" = 9)

rast00 <- raster(wayne_stb_2000, res = 100)
# rast00

cls00 = fasterize(wayne_stb_2000, rast00, field = "cls00", fun="sum")

# plot(cls00, col = cls_color)



lm00 = calculate_lsm(cls00, level = ("class"), what = c("lsm_c_np", "lsm_c_lpi",  "lsm_c_pland", "lsm_c_ai"))

lm_df00 = pivot_wider(lm00[, c("class", "metric", "value")], names_from = metric, values_from = value)

# lm_df00

cls_code00 = data.frame(cls00 = c("WL", "WM", "BL", "BM", "AL", "AM", "HL", "HM", "HD"), class = 1:9)
results00 = merge(cls_code00, lm_df00, by = "class", all.x = TRUE)


# write.csv(results00, "dane/landscape_metrics_2000.csv", row.names = FALSE)


np00 = lsm_l_np(cls00)
# np00

lpi00 = lsm_l_lpi(cls00)
# lpi00

plot(cls00, col = cls_color, main = "2000")

results00 %>%
  kbl() %>%
  kable_classic_2(full_width = F) %>%
  column_spec(1, background = cls_color)

class	cls00	ai	lpi	np	pland
1	WL	98.96183	56.2333554	22	59.6566685
2	WM	96.96735	7.3461197	18	16.2726147
3	BL	98.32376	9.4272390	6	16.5301759
4	BM	92.87581	0.7939386	16	4.5992173
5	AL	NA	NA	NA	NA
6	AM	NA	NA	NA	NA
7	HL	NA	NA	NA	NA
8	HM	96.58839	0.7270477	1	0.7270477
9	HD	93.56692	0.7826859	10	2.2142759

W 2000r. zauważamy względem 1990r. spadek zajętego obszaru WL o 10,7 p.p.. oraz wzrost zajętego obszaru WM o 7,1 p.p. Również niewielkie zmiany dla ludności czarnej oraz ludności o dużym zróżnicowaniu. Nadal brak danych dla Azjatów. Zaś agregacja nadal na wysokim poziomie.

wayne_stb_2010$cls10 = recode(wayne_stb_2010$race_cls, "WL"= 1, "WM" = 2, "BL" = 3, "BM" = 4, "AL" = 5, "AM" = 6, "HL" = 7, "HM" = 8, "HD" = 9)

rast10 <- raster(wayne_stb_2010, res = 100)
# rast10

cls10 = fasterize(wayne_stb_2010, rast10, field = "cls10", fun="sum")

# plot(cls10, col = cls_color)


lm10 = calculate_lsm(cls10, level = ("class"), what = c("lsm_c_np", "lsm_c_lpi",  "lsm_c_pland", "lsm_c_ai"))

lm_df10 = pivot_wider(lm10[, c("class", "metric", "value")], names_from = metric, values_from = value)

# lm_df10

cls_code10 = data.frame(cls10 = c("WL", "WM", "BL", "BM", "AL", "AM", "HL", "HM", "HD"), class = 1:9)
results10 = merge(cls_code10, lm_df10, by = "class", all.x = TRUE)


# write.csv(results10, "dane/landscape_metrics_2010.csv", row.names = FALSE)


np10 = lsm_l_np(cls10)
# np10

lpi10 = lsm_l_lpi(cls10)
# lpi10

plot(cls10, col = cls_color, main = "2010")

results10 %>%
  kbl() %>%
  kable_classic_2(full_width = F) %>%
  column_spec(1, background = cls_color)

class	cls10	ai	lpi	np	pland
1	WL	98.53427	41.9562146	27	48.198947
2	WM	97.43675	13.1024868	20	23.559345
3	BL	98.69360	16.6620822	6	17.499156
4	BM	93.94016	0.9833585	17	5.008064
5	AL	NA	NA	NA	NA
6	AM	NA	NA	NA	NA
7	HL	NA	NA	NA	NA
8	HM	96.92421	1.2990585	1	1.299058
9	HD	94.11597	1.1665271	16	4.435428

W 2010r. względem 1990r. zauważamy jeszcze większe zmiany w obszarze zajętym przez ludność. WL traci łącznie 22,2 p.p., WM zyskuje 14,4 p.p. Ludność czarna zyskuje 3 p.p. Zwiększyła się liczba płatów, która wpłynęła na stosunek powierzchni największego płata do powierzchni obszaru. W tym przypadku wartości zmieniają się bardzo dla WL oraz WM, w mniejszym stopniu dla BL. Jednak nie ma to wpływu na poziom agregacji, który nadal jest bardzo wysoki.

wayne_stb_2020$cls20 = recode(wayne_stb_2020$race_cls, "WL"= 1, "WM" = 2, "BL" = 3, "BM" = 4, "AL" = 5, "AM" = 6, "HL" = 7, "HM" = 8, "HD" = 9)

rast20 <- raster(wayne_stb_2020, res = 100)
# rast20

cls20 = fasterize(wayne_stb_2020, rast20, field = "cls20", fun="sum")

# plot(cls20, col = cls_color)


lm20 = calculate_lsm(cls20, level = ("class"), what = c("lsm_c_np", "lsm_c_lpi",  "lsm_c_pland", "lsm_c_ai"))

lm_df20 = pivot_wider(lm20[, c("class", "metric", "value")], names_from = metric, values_from = value)

# lm_df20

cls_code20 = data.frame(cls20 = c("WL", "WM", "BL", "BM", "AL", "AM", "HL", "HM", "HD"), class = 1:9)
results20 = merge(cls_code20, lm_df20, by = "class", all.x = TRUE)


# write.csv(results20, "dane/landscape_metrics_2020.csv", row.names = FALSE)


np20 = lsm_l_np(cls20)
# np20

lpi20 = lsm_l_lpi(cls20)
# lpi20

plot(cls20, col = cls_color, main = "2020")

results20 %>%
  kbl() %>%
  kable_classic_2(full_width = F) %>%
  column_spec(1, background = cls_color)

class	cls20	ai	lpi	np	pland
1	WL	97.59520	14.2365062	29	30.4103475
2	WM	97.40495	19.1720534	19	32.9303210
3	BL	98.14948	14.9679299	5	15.7743714
4	BM	94.13289	1.7072805	22	7.1848314
5	AL	NA	NA	NA	NA
6	AM	97.01727	0.2106750	1	0.2106750
7	HL	91.57895	0.0962729	4	0.2806917
8	HM	94.97189	0.9802328	2	1.0264938
9	HD	94.61415	3.7533914	30	12.1822683

W 2020r. porównując do 1990r. dochodzi do największych zmian w udziale zajętego obszaru. WL traci aż 40 p.p., WM zyskuje 23,8 p.p., ludność czarna zyskuje 3,45 p.p. (1,8 p.p. względem 2000 roku oraz 0,45 p.p. względem 2010 roku). Liczba płatów zmnieniła się na korzyść ludości o dużym zróżnicowaniu HD - 30 względem 8 z 1990r. Wartości lpi jeszcze bardziej się zmniejszyły względem 2010r. choć niewiele wzrosło w przypadku HD oraz WM. Na dodatek pojawili się Azjaci o średnim zróżnicowaniu. Najmniejsza agregacja występuje u Latynosów o niskim zróżnicowaniu - świadczy to o tym, że część komórek tej klasy nie graniczy ze sobą.

Analiza zmian rasowo-etnicznej struktury ludności w hrabstwie Wayne w latach 1990-2020

Adrian Kurs, Maciej Wiśniewski, Maciej Wołosz, Piotr Pacuła

2024-04-23